home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / TOOLBOX / FORMTOOL.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-12-11  |  10.0 KB  |  413 lines
  1. IMPLEMENTATION MODULE FormTool;
  2.  
  3. (*
  4. Form Tools.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM AES       IMPORT Key,Root,Nil,ObjectIndex,ObjectPtr,
  12.                       TreePtr,TreeIndex,ObjectFlags,ObjectFlag,Outlined,
  13.                       StringRange,Global;
  14. FROM EvntMgr   IMPORT Events,Event,MEvent,EvntEvent;
  15. FROM ObjcMgr   IMPORT MaxDepth,ObjcFind,ObjcEdit,EditModes;
  16. FROM FormMgr   IMPORT FormAlert,FormKeybd,FormButton;
  17. FROM GrafMgr   IMPORT GrafMKState,MouseButton,MBLeft,SpecialKey,
  18.                       GrafMouse,MOn,MOff,GrafHandle;
  19. FROM RsrcMgr   IMPORT RTree,RString,RsrcGAddr;
  20. FROM WindMgr   IMPORT Desk;
  21. FROM RcMgr     IMPORT GRect,GPnt,RcConstrain;
  22. FROM VDI       IMPORT XY;
  23. FROM VRaster   IMPORT MFDB,SOnly,VROCpyFm;
  24. FROM VScreen   IMPORT VSound;
  25. FROM ObjcTool  IMPORT EXCLObjectFlags,INCLObjectFlags,ObjectXYWH;
  26. FROM WindTool  IMPORT BeginMouseControl,EndMouseControl,GetWorkXYWH;
  27. FROM PORTAB    IMPORT SIGNEDWORD,UNSIGNEDWORD,WORDSET,NULL,ANYPOINTER;
  28. FROM INTRINSIC IMPORT VOID;
  29. FROM pSTORAGE  IMPORT ALLOCATE,DEALLOCATE,SIZETYPE;
  30. CAST_IMPORT
  31.  
  32. IMPORT FormMgr,GetObject,SetObject;
  33.  
  34. PROCEDURE DoAlert(DefBut : UNSIGNEDWORD;
  35.                   AlertNo: TreeIndex): UNSIGNEDWORD;
  36.  
  37. VAR AlertAddr: ANYPOINTER;
  38.  
  39. BEGIN
  40.   IF RsrcGAddr(RString,AlertNo,AlertAddr) THEN
  41.     RETURN FormAlert(DefBut,AlertAddr);
  42.   ELSE
  43.     RETURN 65535;
  44.   END;
  45. END DoAlert;
  46.  
  47. PROCEDURE Alert(AlertNo: TreeIndex);
  48. BEGIN
  49.   VOID(DoAlert(1,AlertNo));
  50. END Alert;
  51.  
  52. PROCEDURE OK(AlertNo: TreeIndex): BOOLEAN;
  53. BEGIN
  54.   RETURN DoAlert(1,AlertNo) = 1;
  55. END OK;
  56.  
  57. VAR Buffer: ANYPOINTER;
  58.  
  59. PROCEDURE FormDial(    Dial: FormDials;
  60.                    VAR From: GRect;
  61.                    VAR To  : GRect);
  62.  
  63. CONST WordWidth    = 16; (* Wordbreite in Bits *)
  64.       BytesPerWord = 2;
  65.  
  66. VAR Size     : SIZETYPE;
  67.     WdWidth  : XY;       (* Wordbreite *)
  68.     PixPos   : XY;       (* Pixelposition *)
  69.     PXY      : ARRAY[0..7] OF XY;
  70.     SrcMFDB  : MFDB;
  71.     DstMFDB  : MFDB;
  72.     Work     : GRect;
  73.     AESHandle: UNSIGNEDWORD;
  74.     D        : UNSIGNEDWORD;
  75.  
  76. BEGIN
  77.   GetWorkXYWH(Desk,Work);
  78. #ifdef TDIM2
  79.   (* damned, why this exception for TDI? *)
  80.   WITH To DO
  81.     IF (
  82.         LONG(
  83.              CARDINAL(
  84.                       (GW DIV WordWidth + 2) * GH
  85.                      )
  86.             )
  87.         > MAX(SIZETYPE) DIV LONG(Global.ApNPlanes)
  88.        ) OR
  89.       (GH > Work.GH) OR
  90.       (GW > Work.GW) THEN
  91.       FormMgr.formdial(Dial,From,To);
  92.       RETURN;
  93.     END;
  94.  
  95.     Size:= LONG((GW DIV WordWidth + 2) * GH * INT(Global.ApNPlanes) * BytesPerWord);
  96. #else
  97.   WITH To DO
  98.     IF (VAL(SIZETYPE,(GW DIV WordWidth + 2) * GH) >
  99.         MAX(SIZETYPE) DIV VAL(SIZETYPE,Global.ApNPlanes)) OR
  100.       (GH > Work.GH) OR
  101.       (GW > Work.GW) THEN
  102.       FormMgr.formdial(Dial,From,To);
  103.       RETURN;
  104.     END;
  105.  
  106.     Size:= (GW DIV WordWidth + 2) * GH * INT(Global.ApNPlanes) * BytesPerWord;
  107. #endif
  108.  
  109. (*
  110.   WITH To DO
  111.     IF (VAL(CARDINAL,(GW DIV WordWidth + 2) * GH) >
  112.         MAX(SIZETYPE) DIV VAL(CARDINAL,Global.ApNPlanes)) OR
  113.       (GH > Work.GH) OR
  114.       (GW > Work.GW) THEN
  115.       FormMgr.formdial(Dial,From,To);
  116.       RETURN;
  117.     END;
  118.  
  119.     Size:= (GW DIV WordWidth + 2) * GH * INT(Global.ApNPlanes) * BytesPerWord;
  120. *)
  121.  
  122.     WdWidth:= GW DIV WordWidth;
  123.     PixPos:= GX MOD WordWidth;
  124.  
  125.     SrcMFDB.FDAddr:= NULL;
  126.  
  127.     WITH DstMFDB DO
  128.       FDW:= GW;
  129.       FDH:= GH;
  130.       FDWdWidth:= WdWidth + 2;
  131.       FDStand:= FALSE;
  132.       FDNPlanes:= Global.ApNPlanes;
  133.     END;
  134.  
  135.     AESHandle:= GrafHandle(D,D,D,D);
  136.  
  137.     CASE Dial OF
  138.       FormMgr.FmDStart:
  139.         ALLOCATE(Buffer,Size);
  140.         IF Buffer # NIL THEN
  141.           DstMFDB.FDAddr:= Buffer;
  142.           PXY[0]:= GX;
  143.           PXY[1]:= GY;
  144.           PXY[2]:= GX + GW - 1;
  145.           PXY[3]:= GY + GH - 1;
  146.           PXY[4]:= PixPos;
  147.           PXY[5]:= 0;
  148.           PXY[6]:= GW + INT(PixPos) - 1;
  149.           PXY[7]:= GH - 1;
  150.  
  151.           GrafMouse(MOff,NULL);
  152.           VROCpyFm(AESHandle,SOnly,PXY,SrcMFDB,DstMFDB);
  153.           GrafMouse(MOn,NULL);
  154.         ELSE
  155.           FormMgr.formdial(FormMgr.FmDStart,From,To);
  156.         END;
  157.     | FormMgr.FmDFinish:
  158.         IF Buffer # NIL THEN
  159.           DstMFDB.FDAddr:= Buffer;
  160.           PXY[0]:= PixPos;
  161.           PXY[1]:= 0;
  162.           PXY[2]:= GW + INT(PixPos) - 1;
  163.           PXY[3]:= GH - 1;
  164.           PXY[4]:= GX;
  165.           PXY[5]:= GY;
  166.           PXY[6]:= GX + GW - 1;
  167.           PXY[7]:= GY + GH - 1;
  168.  
  169.           GrafMouse(MOff,NULL);
  170.           VROCpyFm(AESHandle,SOnly,PXY,DstMFDB,SrcMFDB);
  171.           GrafMouse(MOn,NULL);
  172.           DEALLOCATE(Buffer,Size);
  173.         ELSE
  174.           FormMgr.formdial(FormMgr.FmDFinish,From,To);
  175.         END;
  176.     ELSE
  177.       FormMgr.formdial(Dial,From,To);
  178.     END;
  179.   END;
  180. END FormDial;
  181.  
  182. PROCEDURE FormCenter(    Tree: TreePtr;
  183.                      VAR Rect: GRect);
  184.  
  185. CONST Margin = 3; (* documented by Tim Oren *)
  186.  
  187. VAR Work      : GRect;
  188.     Pnt       : GPnt;
  189.     MouseState: MouseButton;
  190.     KeyState  : SpecialKey;
  191.  
  192. BEGIN
  193.   IF (GetObject.X(Tree,Root) = 0) AND (GetObject.Y(Tree,Root) = 0) THEN
  194.     FormMgr.formcenter(Tree,Rect);
  195.     GrafMKState(Pnt,MouseState,KeyState);
  196.     WITH Pnt DO
  197.       Rect.GX:= GX;
  198.       Rect.GY:= GY;
  199.       GetWorkXYWH(Desk,Work);
  200.       RcConstrain(Work,Rect);
  201.       GX:= Rect.GX + Margin;
  202.       GY:= Rect.GY + Margin;
  203.     END;
  204.     SetObject.Pnt(Tree,Root,Pnt);
  205.   ELSE
  206.     GetObject.Rect(Tree,Root,Rect);
  207.     WITH Rect DO
  208.       DEC(GX,Margin);
  209.       DEC(GY,Margin);
  210.       INC(GW,2 * Margin);
  211.       INC(GH,2 * Margin);
  212.     END;
  213.   END;
  214. END FormCenter;
  215.  
  216. PROCEDURE FormDo(Tree : TreePtr;
  217.                  Start: ObjectIndex): SIGNEDWORD;
  218.  
  219. CONST LastEdit = Flag15;
  220.  
  221. TYPE Directions = (FmDDeflt,FmDForward,FmDBackward);
  222.  
  223. VAR Index   : StringRange;
  224.     EditOb  : ObjectPtr;
  225.     NextOb  : ObjectPtr;
  226.     Cont    : BOOLEAN;
  227.     EventRec: MEvent;
  228.     MyEvent : Event;
  229.     D       : UNSIGNEDWORD;
  230.  
  231.   PROCEDURE FindObject(Tree   : TreePtr;
  232.                        Start  : ObjectPtr;
  233.                        Flag   : ObjectFlags;
  234.                        Direct : Directions): ObjectIndex;
  235.  
  236.   VAR Index : ObjectPtr;
  237.       ObFlag: ObjectFlag;
  238.       I     : ObjectPtr;
  239.  
  240.   BEGIN
  241.     Index:= Root;
  242.     I:= 1;
  243.  
  244.     CASE Direct OF
  245.       FmDBackward:
  246.         I:= Nil;
  247.         Index:= Start + I;
  248.     | FmDForward:
  249.         Index:= Start + I;
  250.     | FmDDeflt:
  251.         Flag:= Default;
  252.     END;
  253.  
  254.     WHILE Index >= Root DO
  255.       ObFlag:= GetObject.Flags(Tree,Index);
  256.       IF Flag IN ObFlag THEN
  257.         RETURN Index;
  258.       END;
  259.       IF LastOb IN ObFlag THEN
  260.         Index:= Nil;
  261.       ELSE
  262.         Index:= Index + I;
  263.       END;
  264.     END;
  265.     RETURN Start;
  266.   END FindObject;
  267.  
  268.   PROCEDURE FirstObject(Tree : TreePtr;
  269.                         Start: ObjectIndex): ObjectIndex;
  270.   VAR Last: ObjectIndex;
  271.  
  272.   BEGIN
  273.     IF Start = 0 THEN
  274.       Last:= FindObject(Tree,Root,LastEdit,FmDForward);
  275.       IF Last = Root THEN
  276.         RETURN FindObject(Tree,Root,Editable,FmDForward);
  277.       ELSE
  278.         RETURN Last;
  279.       END;
  280.     ELSE
  281.       RETURN Start;
  282.     END;
  283.   END FirstObject;
  284.  
  285. BEGIN
  286.   BeginMouseControl;
  287.  
  288.   NextOb:= FirstObject(Tree,Start);
  289.   EditOb:= 0;
  290.   Cont:= TRUE;
  291.  
  292.   WHILE Cont DO
  293.     WITH EventRec DO
  294.       IF (NextOb # Root) AND (EditOb # NextOb) THEN
  295.         EditOb:= NextOb;
  296.         NextOb:= Root;
  297.         ObjcEdit(Tree,EditOb,EKR,Index,EdInit);
  298.         EXCLObjectFlags(Tree,EditOb,LastEdit);
  299.       END;
  300.  
  301.       EFlags:= Event{MuKeybd,MuButton};
  302.       EBClk:= 2;
  303.       EBMsk:= MouseButton{MBLeft};
  304.       EBSt:= MouseButton{MBLeft};
  305.  
  306.       MyEvent:= EvntEvent(EventRec);
  307.  
  308.       IF MuKeybd IN MyEvent THEN
  309.         Cont:= FormKeybd(Tree,EditOb,NextOb,EKR,NextOb,EKR);
  310. #if packing
  311.         IF EKR.ScanCode > 0 THEN
  312. #else
  313.         IF EKR > 0 THEN
  314. #endif
  315.           ObjcEdit(Tree,EditOb,EKR,Index,EdChar);
  316.         END;
  317.       END;
  318.  
  319.       IF MuButton IN MyEvent THEN
  320.         NextOb:= ObjcFind(Tree,Root,MaxDepth,EMXY);
  321.         IF NextOb = Nil THEN
  322.           VSound(GrafHandle(D,D,D,D),550,3); (* works fine with A∙B∙C-GEM and NVDI *)
  323.           NextOb:= Root;
  324.         ELSE
  325.           Cont:= FormButton(Tree,NextOb,EBR,NextOb);
  326.         END;
  327.       END;
  328.  
  329.       IF (NOT Cont) OR ((NextOb # Root) AND (NextOb # EditOb)) THEN
  330.         ObjcEdit(Tree,EditOb,EKR,Index,EdEnd);
  331.       END;
  332.  
  333.     END;
  334.   END;
  335.  
  336.   INCLObjectFlags(Tree,EditOb,LastEdit);
  337.  
  338.   EndMouseControl;
  339.  
  340.   RETURN NextOb;
  341. END FormDo;
  342.  
  343. PROCEDURE Mask(RetOb: SIGNEDWORD): ObjectIndex;
  344. BEGIN
  345. #ifdef FTLM2
  346.   RETURN CAST(ObjectIndex,CAST(WORDSET,RetOb) - WORDSET{0});
  347. #else
  348.   RETURN CAST(ObjectIndex,CAST(WORDSET,RetOb) - WORDSET{15});
  349. #endif
  350. END Mask;
  351.  
  352. PROCEDURE DoubleClicked(VAR RetOb: SIGNEDWORD): BOOLEAN;
  353.  
  354. VAR DoubleClick: BOOLEAN;
  355.  
  356. BEGIN
  357.   DoubleClick:= RetOb < 0;
  358. #ifdef FTLM2
  359.   RetOb:= CAST(SIGNEDWORD,CAST(WORDSET,RetOb) - WORDSET{0);
  360. #else
  361.   RetOb:= CAST(SIGNEDWORD,CAST(WORDSET,RetOb) - WORDSET{15});
  362. #endif
  363.   RETURN DoubleClick;
  364. END DoubleClicked;
  365.  
  366. (*
  367. TYPE FormProc = PROCEDURE(TreePtr,ObjectIndex): ObjectIndex;
  368.  
  369. PROCEDURE InstallFormProc(Proc: FormProc);
  370.  
  371. PROCEDURE StandardForm(    Caller : ObjectIndex;
  372.                            TreeNo : ObjectIndex;
  373.                        VAR StartOb: ObjectIndex): ObjectIndex;
  374. *)
  375.  
  376. (*
  377. PROCEDURE DoForm(VAR StartOb: ObjectIndex;
  378.                      Proc   : FormProc;
  379.                      TreeNo : TreeIndex;
  380.                      Caller : ObjectIndex): ObjectIndex;
  381.  
  382. VAR CallerTree: TreePtr;
  383.     Tree      : TreePtr;
  384.     From      : GRect;
  385.     To        : GRect;
  386.     RetObj    : SIGNEDWORD;
  387.  
  388. BEGIN
  389.   BeginUpdate;
  390.   FormCenter(Tree,To);
  391.   FormDial(FmDStart,To,To);
  392.   IF Caller # Nil THEN
  393.     RsrcGAddr(RTree,TreeNo,CallerTree);
  394.     ObjcXYWH(CallerTree,Caller,From);
  395.   ELSE
  396.     XYWHToGRect(0,0,0,0,From);
  397.   END;
  398.  
  399.   FormDial(FmDGrow,From,To);
  400.   ObjcDraw(Tree,Root,MaxDepth,To);
  401.   RetObj:= Proc(Tree,StartOb);
  402.   ExclObjcState(Tree,RetObj,Selected);
  403.   FormDial(FmDShrink,From,To);
  404.   FormDial(FmDFinish,To,To);
  405.   EndUpdate;
  406.   RETURN RetObj;
  407. END StandardForm;
  408. *)
  409. BEGIN
  410.   Buffer:= NIL;
  411. END FormTool.
  412.  
  413.